home *** CD-ROM | disk | FTP | other *** search
/ Delphi Magazine Collection 2001 / Delphi Magazine Collection 20001 (2001).iso / DISKS / Issue31 / extend / XPDELPHI.DPR < prev    next >
Encoding:
Text File  |  1997-05-28  |  3.0 KB  |  175 lines

  1. { Created: 1997-02-14 by Berend  (c) 1997 by ASC
  2.  
  3. Sample Extended stored procedures.
  4.  
  5. $Revision: $
  6.  
  7.  
  8. $History$
  9.  
  10. }
  11.  
  12.  
  13. library xpdelphi;
  14.  
  15. uses
  16.   Windows,
  17.   SysUtils,
  18.   Classes,
  19.   Odsxp;
  20.  
  21.  
  22. type
  23. { simple examples }
  24.   TXPIncByOne1 = class(TSQLXProc)
  25.     function Execute: Boolean; override;
  26.   end;
  27.  
  28.   TXPIncByOne2 = class(TSQLXProc)
  29.     function Execute: Boolean; override;
  30.   end;
  31.  
  32. { examples from xp.c }
  33.   TXPEcho = class(TSQLXProc)
  34.     function Execute: Boolean; override;
  35.   end;
  36.  
  37.   TXPDiskList = class(TSQLXProc)
  38.     function Execute: Boolean; override;
  39.   end;
  40.  
  41.  
  42.  
  43. { TXPIncByOne1 }
  44.  
  45. function TXPIncByOne1.Execute: Boolean;
  46. begin
  47.   Params[1] := Params[1] + 1;
  48.   Result := True;
  49. end;
  50.  
  51.  
  52. { TXPIncByOne2 }
  53.  
  54. function TXPIncByOne2.Execute: Boolean;
  55. var
  56.   myint: integer;
  57. begin
  58.   DescribeColumn('my column name', SRVINT4, 4, SRVINT4, 4, @myint);
  59.   Myint := Params[1] + 1;
  60.   SendRow;
  61.   Result := True;
  62. end;
  63.  
  64.  
  65. { TXPEcho }
  66.  
  67. function TXPEcho.Execute: Boolean;
  68. begin
  69.   Params[2] := Params[1];
  70.   Result := True;
  71. end;
  72.  
  73.  
  74. { TXPDiskList }
  75.  
  76. function TXPDiskList.Execute: Boolean;
  77. var
  78.   drivename: char;
  79.   space_remaining: Int32;
  80.   drivenums: Int32;
  81.   rootname: string;
  82.   SectorsPerCluster,
  83.   BytesPerSector,
  84.   NumberOfFreeClusters,
  85.   TotalNumberOfClusters: dword;
  86.  
  87.   function IsDrive(drive: char): Boolean;
  88.   begin
  89.     IsDrive := (drivenums and (1 shl (Ord(drive) - Ord('A')))) <> 0;
  90.   end;
  91.  
  92. begin
  93.   DescribeColumn('drive', SRVCHAR, 1, SRVCHAR, 1, @drivename);
  94.   DescribeColumn('bytes free', SRVINT4, 4, SRVINT4, 4, @space_remaining);
  95.   drivenums := GetLogicalDrives;
  96.   for drivename := 'C' to 'Z' do  begin
  97.     if IsDrive(drivename) then  begin
  98.       rootname := drivename + ':\';
  99.       GetDiskFreeSpace(PChar(rootname), SectorsPerCluster, BytesPerSector, NumberOfFreeClusters, TotalNumberOfClusters);
  100.       space_remaining := SectorsPerCluster * NumberOfFreeClusters * BytesPerSector;
  101.       SendRow;
  102.     end;
  103.   end;
  104.   Result := True;
  105. end;
  106.  
  107.  
  108.  
  109. { xp_incbyone1 }
  110.  
  111. function xp_incbyone1(srvproc: PSRV_PROC): SRVRETCODE;
  112. const
  113.   ExpectedParams = 1;
  114. var
  115.   xp: TSQLXProc;
  116. begin
  117.   xp := TXPIncByOne1.Create(srvproc, ExpectedParams);
  118.   Result := xp.Run;
  119.   xp.Free;
  120. end;
  121.  
  122.  
  123. { xp_incbyone2 }
  124.  
  125. function xp_incbyone2(srvproc: PSRV_PROC): SRVRETCODE;
  126. const
  127.   ExpectedParams = 1;
  128. var
  129.   xp: TSQLXProc;
  130. begin
  131.   xp := TXPIncByOne2.Create(srvproc, ExpectedParams);
  132.   Result := xp.Run;
  133.   xp.Free;
  134. end;
  135.  
  136.  
  137. { xp_echo }
  138.  
  139. function xp_delphiecho(srvproc: PSRV_PROC): SRVRETCODE;
  140. const
  141.   ExpectedParams = 2;
  142. var
  143.   xp: TSQLXProc;
  144. begin
  145.   xp := TXPEcho.Create(srvproc, ExpectedParams);
  146.   Result := xp.Run;
  147.   xp.Free;
  148. end;
  149.  
  150.  
  151. { xp_disklist }
  152.  
  153. function xp_delphidisklist(srvproc: PSRV_PROC): SRVRETCODE;
  154. const
  155.   ExpectedParams = 0;
  156. var
  157.   xp: TSQLXProc;
  158. begin
  159.   xp := TXPDiskList.Create(srvproc, ExpectedParams);
  160.   Result := xp.Run;
  161.   xp.Free;
  162. end;
  163.  
  164.  
  165.  
  166. exports
  167.   xp_incbyone1 index 1,
  168.   xp_incbyone2 index 2,
  169.   xp_delphiecho index 3,
  170.   xp_delphidisklist index 4;
  171.  
  172.  
  173. begin
  174. end.
  175.